Shareware Grab Bag/Shareware Grab Bag.iso/090/me39doc.arc/BOXMAC.CMD

Text File | 1987-07-12 | 11.6 KB | 590 lines

;    BOXMAC.CMD:    Standard Micro Startup Box drawing macroes
;            for MicroEMACS 3.9
;            (C)opyright 1987 by Suresh Konda and Daniel M Lawrence
;            Last Update: 07/12/87

write-message "[Loading Box Macroes]"

;this macro inserts enough characters at the end of line to lineup with point
store-procedure mvtopcol
;set $debug TRUE
    end-of-line
    set %temp &sub %pcol $curcol
    !if &less $curcol %pcol
    ;;    current position to left of point -- blank fill to point
    ;    !if &gre %temp 0
            %temp    insert-string " "
    ;    !endif
    !else
        !if &less %temp 0
            set %temp &neg %temp
            %temp backward-character
        !else
            %temp forward-character
        !endif
    !endif
!endm
;this macro inserts enough characters at the end of line to lineup with mark
store-procedure mvtomcol
;set $debug TRUE
    end-of-line
    !if &less %mcol $curcol
    ;;    current position to right of mark -- move to mark
;        insert-string &cat &cat %mcol " " $curcol
        beginning-of-line
        %mcol forward-character
    !else
    ;;      current position is to left of mark -- blank fill
        set %temp &sub %mcol $curcol
        !if &gre %temp 0
            %temp insert-string " "
        !endif
    !endif
!endm

store-procedure inschar
    !if &equal %char 205
        insert-string &chr %c1
    !else
        !if &equal %char 196
            insert-string &chr %c2
        !else
            insert-string &chr %c3
        !endif
    !endif
!endm
store-procedure box2
;remember point
    set %pcol &add $curcol 1
    set %pline $curline
    exchange-point-and-mark
;remember mark
;    set %mcol &add $curcol 1
    set %mcol $curcol
    set %mline $curline
;draw top horizontal line
    insert-string "╔"
    set %width &sub &sub %pcol %mcol 1
    %width insert-string "═"
     insert-string "╗"
    newline-and-indent
;    insert-string " "
;draw bottom horizontal line
    %pline goto-line
; we are now one line above old last line because of insertion of top line
    next-line
    end-of-line
    newline
    run mvtomcol
    insert-string "╚"
    %width insert-string "═"
    insert-string "╝"
; bump pline
set %pline &add %pline 1
;draw verticals
    %mline goto-line
;we are at top -- draw verticals
*lp1
    next-line
    run mvtomcol
    insert-string "║"
    run mvtopcol
    insert-string "║"
    !if &less $curline %pline
        !goto lp1
    !endif
;return to point
    %pline goto-line
    next-line
    beginning-of-line
    %width forward-character
    2 forward-character
!endm
store-procedure setpoints
;; procedure will set pcol, pline, mcol and mline
set %pcol $curcol
set %pline $curline
exchange-point-and-mark
set %mcol $curcol
set %mline $curline
exchange-point-and-mark
!endm

;; user procedure to draw a double line from mark to point making spaces for
;; the characters.
store-procedure line2
run setpoints
!if &equal %pcol %mcol
    run vert2
!else
    !if &equal %pline %mline
        run hor2
    !else
        write-message "Illegal point and mark for lines"
    !endif
!endif
!endm

;; user procedure to draw line from mark to point making spaces for
;; the characters.
store-procedure line1
run setpoints
!if &equal %pcol %mcol
    run vert1
!else
    !if &equal %pline %mline
        run hor1
    !else
        write-message "Illegal point and mark for lines"
    !endif
!endif
!endm

store-procedure hor2
;; procedure to draw a double line from beginning of line to point
;; assume that the current line is to be double underlined.  pcol,mcol,pline,
;; mline already set by calling macro
!if &equal %mcol %pcol
    write-message "in hor equal cols"
    !return
!endif
!if &less %pcol %mcol
;    then point was to left of mark.  exchange and reset variables
    exchange-point-and-mark
    run setpoints
!endif
end-of-line
newline
;; move to under mark
!if &greater %mcol 1
    %mcol insert-string " "
!endif
;; see if first char is a vertical line
previous-line
set %char  $curchar
next-line
!if &equ %char 186
        insert-string "╠"
!else
    !if &equ %char 179
        insert-string "╞"
    !else
        insert-string "═"
    !endif
!endif

; now for all chars but the last character i.e., char at point
*lp1
    previous-line
    set %char  $curchar
    next-line
    !if &equ %char 186
        insert-string "╬"
        !else
        !if &equ %char 179
            insert-string "╪"
        !else
            insert-string "═"
        !endif
    !endif
    !if &less $curcol %pcol
        !goto lp1
    !endif
;; see if last char is a vertical line
previous-line
set %char  $curchar
next-line
!if &equ %char 186
        insert-string "╣"
!else
    !if &equ %char 179
        insert-string "╡"
    !else
        insert-string "═"
    !endif
!endif
!endm

store-procedure hor1
;; procedure to draw a single line from beginning of line to point
!if &equal %mcol %pcol
    write-message "in hor equal cols"
    !return
!endif
!if &less %pcol %mcol
;    then point was to left of mark.  exchange and reset variables
    exchange-point-and-mark
    run setpoints
!endif
end-of-line
newline
;; move to under mark
!if &greater %mcol 1
    %mcol insert-string " "
!endif
;; see if first char is a vertical line
previous-line
set %char  $curchar
next-line
!if &equ %char 186
        insert-string "╟"
!else
    !if &equ %char 179
        insert-string "├"
    !else
        insert-string "─"
    !endif
!endif

; now for all chars but the last character i.e., char at point
*lp1
    previous-line
    set %char  $curchar
    next-line
    !if &equ %char 186
        insert-string "╫"
        !else
        !if &equ %char 179
            insert-string "┼"
        !else
            insert-string "─"
        !endif
    !endif
    !if &less $curcol %pcol
        !goto lp1
    !endif
;; see if last char is a vertical line
previous-line
set %char  $curchar
next-line
!if &equ %char 186
        insert-string "╢"
!else
    !if &equ %char 179
        insert-string "┤"
    !else
        insert-string "─"
    !endif
!endif
!endm

store-procedure vert2
;; procedure to draw a line from mark to point.  mark should be above point
;; this will insert a column of double lines
!if &equal %mline %pline
    !return
!endif
!if &less %pline %mline
;    then point was above mark.  exchange and reset variables
    exchange-point-and-mark
    run setpoints
!endif
;top line
%mline goto-line
beginning-of-line
run mvtopcol
backward-character
set %char $curchar
forward-character

!if &equal %char 205
    insert-string "╦"
!else
    !if &equal %char 196
        insert-string "╥"
    !else
        insert-string "║"
    !endif
!endif
;all but pline
*lp1
    next-line
    beginning-of-line
    run mvtopcol
    backward-character
    set %char $curchar
    forward-character
    !if &equal %char 205
        insert-string "╬"
    !else
        !if &equal %char 196
            insert-string "╫"
        !else
            insert-string "║"
        !endif
    !endif
    !if &less $curline &sub %pline 1
        !goto lp1
    !endif
; bottom line
next-line
beginning-of-line
run mvtopcol
backward-character
set %char $curchar
forward-character
!if &equal %char 205
    insert-string "╩"
!else
    !if &equal %char 196
        insert-string "╨"
    !else
        insert-string "║"
    !endif
!endif
!if &less $curcol &sub %pcol 1
    !goto lp1
!endif
!endm

store-procedure vert1
;; procedure to draw a line from mark to point.  mark should be above point
;; this will insert a column of double lines
!if &equal %mline %pline
    !return
!endif
!if &less %pline %mline
;    then point was above mark.  exchange and reset variables
    exchange-point-and-mark
    run setpoints
!endif
;top line
%mline goto-line
beginning-of-line
run mvtopcol
backward-character
set %char $curchar
forward-character

!if &equal %char 205
    insert-string "╤"
!else
    !if &equal %char 196
        insert-string "┬"
    !else
        insert-string "│"
    !endif
!endif
;all but pline
*lp1
    next-line
    beginning-of-line
    run mvtopcol
    backward-character
    set %char $curchar
    forward-character
    !if &equal %char 205
        insert-string "╪"
    !else
        !if &equal %char 196
            insert-string "┼"
        !else
            insert-string "│"
        !endif
    !endif
    !if &less $curline &sub %pline 1
        !goto lp1
    !endif
; bottom line
next-line
beginning-of-line
run mvtopcol
backward-character
set %char $curchar
forward-character
!if &equal %char 205
    insert-string "╧"
!else
    !if &equal %char 196
        insert-string "┴"
    !else
        insert-string "│"
    !endif
!endif
!if &less $curcol &sub %pcol 1
    !goto lp1
!endif
!endm


;; user procedure to insert blanks from mark to point making spaces for
store-procedure blank
run setpoints
!if &equal %pcol %mcol
    run vblank
!else
    !if &equal %pline %mline
        run hblank
    !else
        write-message "Illegal point and mark for blanking"
    !endif
!endif
!endm

store-procedure chkh2
;; procedure to check if the horizontal blanking routine should insert a
;; double vertical line.  Sets a global variable yes to true if yes
    set %yes &greater &sindex "╢╖╣║╗╟╔╦╠╬╥╓╫" %char 1
!endm

store-procedure chkh1
;; procedure to check if the horizontal blanking routine should insert a
;; single vertical line.  Sets a global variable yes to true if yes
    !if &greater &sindex %temp "│┤╡╕┐┬┼╞╒╪┌╤" 1
        set %yes TRUE
    !else
        set %yes FALSE
!endm

store-procedure hblank
;; procedure to insert blanks horizontally from mark to point
;; assume that the current line is to be double underlined.  pcol,mcol,pline,
;; mline already set by calling macro
!if &equal %mcol %pcol
    write-message "NULL Space to Fill"
    !return
!endif
!if &less %pcol %mcol
;    then point was to left of mark.  exchange and reset variables
    exchange-point-and-mark
    run setpoints
!endif
end-of-line
newline
;; move to under mark
!if &greater %mcol 1
    %mcol insert-string " "
!endif
;; increment %pcol for loop counter
set %pcol &add %pcol 1
;; loop through to point
*lp1
    previous-line
    set %char &chr $curchar
    next-line
    execute-procedure chkh2
    !if %yes
        insert-string "║"
        !else
        execute-procedure chkh1
        !if %yes
            insert-string "│"
        !else
            insert-string " "
        !endif
    !endif
    !if &less $curcol %pcol
        !goto lp1
    !endif
!endm

store-procedure chkv2
;; procedure to check if the vertical blanking routine should insert a
;; double horizontal line.  Sets a global variable yes to true if yes
    set %temp 1
*lp1
    !if &seq &mid "╞╚╔╩╦╠═╬╧╤╘╒╪" %temp 1 %char
        set %yes TRUE
        !return
    !else
        set %temp &add %temp 1
;    check if %temp is >= 1+ length of check string
        !if &gre %temp 14
            set %yes FALSE
            !return
        !endif
        !goto lp1
    !endif
!endm


store-procedure chkv1
;; procedure to check if the vertical blanking routine should insert a
;; single horizontal line.  Sets a global variable yes to true if yes
    set %temp 1
*lp1
    !if &seq &mid "└┴┬├─┼╟╨╥╙╓╫" %temp 1 %char
        set %yes TRUE
        !return
    !else
        set %temp &add %temp 1
;    check if %temp is >= 1+ length of check string
        !if &gre %temp 13
            set %yes FALSE
            !return
        !endif
        !goto lp1
    !endif
!endm


store-procedure vblank
;; procedure to vertical blanks from mark to point.  mark should be above point
!if &equal %mline %pline
    !return
!endif
!if &less %pline %mline
;    then point was above mark.  exchange and reset variables
    exchange-point-and-mark
    run setpoints
!endif
;top line
%mline goto-line
beginning-of-line
run mvtopcol
backward-character
set %char $curchar
forward-character

!if &equal %char 205
    insert-string "═"
!else
    !if &equal %char 196
        insert-string "─"
    !else
        insert-string " "
    !endif
!endif
;all but pline
*lp1
    next-line
    beginning-of-line
    run mvtopcol
    backward-character
    set %char $curchar
    forward-character
    !if &equal %char 205
        insert-string "═"
    !else
        !if &equal %char 196
            insert-string "─"
        !else
            insert-string " "
        !endif
    !endif
    !if &less $curline &sub %pline 1
        !goto lp1
    !endif
; bottom line
!if &equal $curline %pline
    !return
!endif
next-line
beginning-of-line
run mvtopcol
backward-character
set %char $curchar
forward-character
!if &equal %char 205
    insert-string "═"
!else
    !if &equal %char 196
        insert-string "─"
    !else
        insert-string " "
    !endif
!endif
!endm

clear-message-line